home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / IPRINT.ICN < prev    next >
Text File  |  1992-09-28  |  7KB  |  259 lines
  1. ############################################################################
  2. #
  3. #    File:     iprint.icn
  4. #
  5. #    Subject:  Program to print Icon program
  6. #
  7. #    Author:   Robert J. Alexander
  8. #
  9. #    Date:     June 10, 1988
  10. #
  11. ###########################################################################
  12. #  
  13. #     The defaults are set up for printing of Icon programs, but
  14. #  through command line options it can be set up to print programs
  15. #  in other languages, too (such as C). This program has several
  16. #  features:
  17. #  
  18. #     If a program is written in a consistent style, this program
  19. #  will attempt to keep whole procedures on the same page. The
  20. #  default is to identify the end of a print group (i.e. a pro-
  21. #  cedure) by looking for the string "end" at the beginning of a
  22. #  line. Through the -g option, alternative strings can be used to
  23. #  signal end of a group. Using "end" as the group delimiter
  24. #  (inclusive), comments and declarations prior to the procedure are
  25. #  grouped with the procedure. Specifying a null group delimiter
  26. #  string (-g '') suppresses grouping.
  27. #  
  28. #     Page creases are skipped over, and form-feeds (^L) imbedded in
  29. #  the file are handled properly. (Form-feeds are treated as spaces
  30. #  by many C compilers, and signal page ejects in a listing). Page
  31. #  headings (file name, date, time, page number) are normally
  32. #  printed unless suppressed by the -h option.
  33. #  
  34. #     Options:
  35. #  
  36. #       -n   number lines.
  37. #  
  38. #       -pN  page length: number of lines per page (default: 60
  39. #            lines).
  40. #  
  41. #       -tN   tab stop spacing (default: 8).
  42. #  
  43. #       -h   suppress page headings.
  44. #  
  45. #       -l   add three lines at top of each page for laser printer.
  46. #  
  47. #       -gS  end of group string (default: "end").
  48. #  
  49. #       -cS  start of comment string (default: "#").
  50. #  
  51. #       -xS  end of comment string (default: none).
  52. #  
  53. #       -i   ignore FF at start of line.
  54. #  
  55. #     Any number of file names specified will be printed, each
  56. #  starting on a new page.
  57. #  
  58. #     For example, to print C source files such as the Icon source
  59. #  code, use the following options:
  60. #  
  61. #     iprint -g ' }' -c '/*' -x '*/' file ...
  62. #  
  63. #     Control lines:
  64. #  
  65. #     Control lines are special character strings that occur at the
  66. #  beginnings of lines that signal special action. Control lines
  67. #  begin with the start of comment string (see options). The control
  68. #  lines currently recognized are:
  69. #  
  70. #     <comment string>eject -- page eject (line containing "eject"
  71. #  does not print).
  72. #  
  73. #     <comment string>title -- define a title line to print at top
  74. #  of each page. Title text is separated from the <comment
  75. #  string>title control string by one space and is terminated by
  76. #  <end of comment string> or end of line, whichever comes first.
  77. #  
  78. #     <comment string>subtitle -- define a sub-title line to print
  79. #  at top of each page. Format is parallel to the "title" control
  80. #  line, above.
  81. #  
  82. #     If a page eject is forced by maximum lines per page being
  83. #  exceeded (rather than intentional eject via control line, ff, or
  84. #  grouping), printing of blank lines at the top of the new page is
  85. #  suppressed. Line numbers will still be printed correctly.
  86. #  
  87. ############################################################################
  88. #
  89. #  Links: options
  90. #
  91. ############################################################################
  92.  
  93. global pagelines,tabsize,lines,page,datetime,title,subtitle,pagestatus,blanks,
  94.     group,numbers,noheaders,hstuff,gpat,comment,comment_end,laser,
  95.     ignore_ff
  96.  
  97. procedure main(arg)
  98.   local files,x
  99.   &dateline ? {tab(find(",")) ; move(2) ; datetime := tab(0)}
  100.   files := []
  101.   pagelines := 60
  102.   tabsize := 8
  103.   gpat := "end"
  104.   comment := "#"
  105.  
  106.   while x := get(arg) do {
  107.     if match("-",x) then {    # Arg is an option
  108.       case x[2] of {
  109.     "n": numbers := "yes"
  110.     "p": {
  111.       pagelines := ("" ~== x[3:0]) | get(arg)
  112.       if not (pagelines := integer(pagelines)) then
  113.         stop("Invalid -p parameter: ",pagelines)
  114.     }
  115.     "t": {
  116.       tabsize := ("" ~== x[3:0]) | get(arg)
  117.       if not (tabsize := integer(tabsize)) then
  118.         stop("Invalid -t parameter: ",tabsize)
  119.     }
  120.     "h": noheaders := "yes"
  121.     "l": laser := "yes"
  122.     "g": {
  123.       gpat := ("" ~== x[3:0]) | get(arg)
  124.     }
  125.     "c": {
  126.       comment := ("" ~== x[3:0]) | get(arg)
  127.     }
  128.     "x": {
  129.       comment_end := ("" ~== x[3:0]) | get(arg)
  130.     }
  131.     "i": ignore_ff := "yes"
  132.     default: stop("Invalid option ",x)
  133.       }
  134.     }
  135.     else put(files,x)
  136.   }
  137.   if *files = 0 then stop("usage: iprint -options file ...\n_
  138.     options:\n_
  139.     \t-n\tnumber the lines\n_
  140.     \t-p N\tspecify lines per page (default 60)\n_
  141.     \t-t N\tspecify tab width (default 8)\n_
  142.     \t-h\tsuppress page headers\n_
  143.     \t-l\tadd 3 blank lines at top of each page\n_
  144.     \t-g S\tpattern for last line in group\n_
  145.     \t-c S\t'start of comment' string\n_
  146.     \t-x S\t'end of comment' string\n_
  147.     \t-i\tignore FF")
  148.   every x := !files do expand(x)
  149. end
  150.  
  151. procedure expand(fn)
  152.   local f,line,cmd,linenbr,fname
  153.   f := open(fn) | stop("Can't open ",fn)
  154.   fn ? {
  155.     while tab(find("/")) & move(1)
  156.     fname := tab(0)
  157.   }
  158.   hstuff := fname || "  " || datetime || "  page "
  159.   title := subtitle := &null
  160.   lines := pagelines
  161.   page := 0 ; linenbr := 0
  162.   group := []
  163.   while line := trim(read(f)) do {
  164.     if \ignore_ff then while match("\f",line) do line[1] := ""
  165.     linenbr +:= 1
  166.     if match("\f",line) then {
  167.       dumpgroup()
  168.       lines := pagelines
  169.       repeat {
  170.     line[1] := ""
  171.     if not match("\f",line) then break
  172.       }
  173.     }
  174.     line ? {
  175.       if =comment & cmd := =("eject" | "title" | "subtitle") then {
  176.     dumpgroup()
  177.     case cmd of {        # Command line
  178.       "title": (move(1) & title := trim(tab(find(comment_end)))) |
  179.         (title := &null)
  180.       "subtitle": (move(1) & subtitle := trim(tab(find(comment_end)))) |
  181.         (subtitle := &null)
  182.     }
  183.     lines := pagelines
  184.       }
  185.       else {    # Ordinary (non-command) line
  186.     if not (*group = 0 & *line = 0) then {
  187.       put(group,line)
  188.       if \numbers then put(group,linenbr)
  189.     }
  190.     if endgroup(line) then dumpgroup()
  191.       }
  192.     }
  193.   }
  194.   dumpgroup()
  195.   close(f)
  196.   lines := pagelines
  197. end
  198.  
  199. procedure dumpgroup()
  200.   local line,linenbr
  201.   if *group > 0 then {
  202.     if lines + *group / ((\numbers & 2) | 1) + 2 >= pagelines then
  203.     lines := pagelines
  204.     else {write("\n") ; lines +:= 2}
  205.     while line := get(group) do {
  206.       if \numbers then linenbr := get(group)
  207.       if lines >= pagelines then {
  208.     printhead()
  209.       }
  210.       if *line = 0 then {
  211.     if pagestatus ~== "empty" then {blanks +:= 1 ; lines +:= 1}
  212.     next
  213.       }
  214.       every 1 to blanks do write()
  215.       blanks := 0
  216.       pagestatus := "not empty"
  217.       if \numbers then writes(right(linenbr,5)," ")
  218.       write(detab(line))
  219.       lines +:= 1
  220.     }
  221.   }
  222.   return
  223. end
  224.  
  225. procedure endgroup(s)
  226.   return match("" ~== gpat,s)
  227. end
  228.  
  229. procedure printhead()
  230.   static ff,pg
  231.   writes(ff) ; ff := "\f"
  232.   lines := 0
  233.   pg := string(page +:= 1)
  234.   if /noheaders then {
  235.     if \laser then write("\n\n")
  236.     write(left(\title | "",79 - *hstuff - *pg),hstuff,pg)
  237.     lines +:= 2
  238.     write(\subtitle) & lines +:= 1
  239.     write()
  240.   }
  241.   pagestatus := "empty"
  242.   blanks := 0
  243.   return
  244. end
  245.  
  246. procedure detab(s)
  247.   local t
  248.   t := ""
  249.   s ? {
  250.     while t ||:= tab(find("\t")) do {
  251.       t ||:= repl(" ",tabsize - *t % tabsize)
  252.       move(1)
  253.     }
  254.     t ||:= tab(0)
  255.   }
  256.   return t
  257. end
  258.  
  259.